
;;************************************************************************
;; boxplot3.lsp 
;; contains boxplot overlay code
;; copyright (c) 1993-99 by Forrest W. Young
;;************************************************************************

(defproto boxplot-overlay-proto '(long-text short-text draw-text draw-loc) () 
  vista-graph-overlay-proto)

(defmeth boxplot-overlay-proto :long-text (&optional (string-list nil set))
"Args: (&optional logical)
Sets or returns long-text."
  (if set (setf (slot-value 'long-text) string-list))
  (slot-value 'long-text))

(defmeth boxplot-overlay-proto :short-text (&optional (string-list nil set))
"Args: (&optional logical)
Sets or returns short-text."
  (if set (setf (slot-value 'short-text) string-list))
  (slot-value 'short-text))

(defmeth boxplot-overlay-proto :draw-text (&optional (string-list nil set))
"Args: (&optional logical)
Sets or returns draw-text."
  (if set (setf (slot-value 'draw-text) string-list))
  (slot-value 'draw-text))

(defmeth boxplot-overlay-proto :draw-loc (&optional (num-list nil set))
"Args: (&optional logical)
Sets or returns draw-loc."
  (if set (setf (slot-value 'draw-loc) num-list))
  (slot-value 'draw-loc))

(defmeth boxplot-overlay-proto :isnew ()
  (send self :long-text '("Box" "Diamond" "Medians" "Means" "Connect"))
  (send self :short-text '("Bx" "Dmd" "Mdn" "Mn" "Cnct"))
  (send self :draw-text (send self :long-text))
  (call-next-method))

(defmeth boxplot-overlay-proto :redraw ()
  (let* ((graph (send self :graph))
         (draw-color (send graph :draw-color))
         (color-mode (send (send graph :button-overlay) :color-mode))
         (mouse-mode (send graph :mouse-mode))
         (mouse (format nil "~A" mouse-mode))
         (height 10)
         (width  10)
         (gap 2)
         (button-gap 4)
         (long-text  (copy-list (send self :long-text)))
         (short-text (copy-list (send self :short-text)))
         (wlist  (mapcar #'(lambda (text)
                             (send graph :text-width text))
                         long-text))
         (loclist wlist)
         (wwlist (mapcar #'(lambda (text)
                             (send graph :text-width text))
                         short-text))
         (topx 10)
         (topy (- (send graph :canvas-height) 15))
         (cw (send graph :canvas-width))
         (bottom (- topy 3))
         (locx 0))
    (cond
      ((equal mouse "BRUSHING") (setf mouse "Brush"))
      ((equal mouse "SELECTING") (setf mouse "Select"))
      ((equal mouse "HAND-ROTATE") (setf mouse "Spin"))
      ((equal mouse "NO-ACTION") (setf mouse "")))
    (when (not color-mode) (send graph :use-color nil))
    (if (and color-mode (send *vista* :background-color)) 
        (send graph :draw-color 'toolbar-background)
        (send graph :draw-color 'white))
    (send graph :paint-rect 0 bottom (send graph :canvas-width) bottom)
    (if (and color-mode (send *vista* :background-color))
        (send graph :draw-color draw-color)
        (send graph :draw-color 'black))
    (setf draw-text long-text)
    (setf locx (+ locx topx width button-gap (select loclist 0)))
    (setf locx (+ locx width (* 2 button-gap) (select loclist 1)))
    (when (> (length (send graph :data)) 1) 
          (setf locx (+ locx width (* 2 button-gap) (select loclist 2)))
          (setf locx (+ locx width (* 2 button-gap) (select loclist 3)))
          (when (send graph :enable-connect-points)
                (setf locx (+ locx width (* 2 button-gap) (select loclist 4)))))
    (when (> locx cw)
          (dotimes (i (length long-text))
                   (setf locx (+ (- locx (select wlist i)) (select wwlist i)))
                   (setf (select draw-text i) (select short-text i))
                   (setf (select loclist i) (select wwlist i))
                   (when (< locx cw) (return))))
    (setf locx 0)
    (send self :draw-text draw-text)
    (send self :draw-loc loclist)
    (send self :locate-boxes graph
          topy height topx width bottom locx gap button-gap draw-text loclist)
          
    ))


(defmeth boxplot-overlay-proto :locate-boxes
  (graph topy height topx width bottom locx gap button-gap textlist loclist)
    (send graph :draw-line 0 bottom (send graph :canvas-width) bottom )
    (send self :draw-button (send graph :boxes) topx topy width height)
    (send graph :draw-string 
          (select textlist 0) (+ topx width gap) (+ topy height))
    (setf locx (+ locx topx width button-gap (select loclist 0)))
    (send self :draw-button (send graph :diamonds) locx topy width height)
    (send graph :draw-string (select textlist 1) 
          (+ locx width button-gap) (+ topy height))
    (setf locx (+ locx width (* 2 button-gap) (select loclist 1)))
    (when (> (length (send graph :data)) 1)        
          (send self :draw-button  
                (send graph :median-line) locx topy width height)
          (send graph :draw-string (select textlist 2) 
                (+ locx width button-gap) (+ topy height))
          (setf locx (+ locx width (* 2 button-gap) (select loclist 2)))
          (send self :draw-button 
                (send graph :mean-line) locx topy width height)
          (send graph :draw-string (select textlist 3) 
                (+ locx width button-gap) (+ topy height))
          (setf locx (+ locx width (* 2 button-gap) (select loclist 3)))
          (when (send graph :enable-connect-points)
                (send self :draw-button 
                      (send graph :connect-points) locx topy width height)
                (send graph :draw-string (select textlist 4) 
                      (+ locx width button-gap) (+ topy height)))
          (setf locx (+ locx width (* 2 button-gap) (select loclist 4))))
    )

(defmeth boxplot-overlay-proto :do-click (x y m1 m2)
  (let* ((graph (send self :graph))
         (height 10)
         (width  10)
         ;(gap 2)
         (button-gap 4)
         (wlist (send self :draw-loc))
         (draw-loc (send self :draw-loc))
         (topx 10)
         (topy (- (send graph :canvas-height) 15))
         (bottom (- topy 3))
         (locx 0)
         (num-obs (length (first (send graph :data)))))
    (send self :locate-click graph
          topy y height topx x width bottom locx draw-loc button-gap)
    ))

(defmeth boxplot-overlay-proto :locate-click
  (graph topy y height topx x width bottom locx text-loc button-gap)
  (when (< topy y (+ topy height))
        (when (< topx x (+ topx width)) 
              (send self :draw-button 
                    (not (send graph :boxes)) topx topy width height)
              (send graph :switch-boxes))
         (setf locx (+ locx topx width button-gap (select text-loc 0)))
        (when (< locx x (+ locx width)) 
              (send self :draw-button 
                    (not (send graph :diamonds)) locx topy width height)
              (send graph :switch-diamonds))
          (when (> (length (send graph :data)) 1)
                (setf locx (+ locx width (* 2 button-gap) (select text-loc 1)))
                (when (< locx x (+ locx width))
                      (send self :draw-button (not (send graph :median-line))
                            locx topy width height)
                      (send graph :switch-median-line))
                (setf locx (+ locx width (* 2 button-gap) (select text-loc 2)))
                (when (< locx x (+ locx width))
                      (send self :draw-button (not (send graph :mean-line))
                            locx topy width height)
                      (send graph :switch-mean-line))
                (setf locx (+ locx width (* 2 button-gap) (select text-loc 3)))
                (when (send graph :enable-connect-points)
                      (when (< locx x (+ locx width))
                            (send self :draw-button 
                                  (not (send graph :connect-points))
                                  locx topy width height)
                            (send graph :switch-connect-points))))))


(defmeth boxplot-overlay-proto :draw-button (paint a b c d)
  (let* ((graph (slot-value 'graph))
         (on-color 'button-on-color)
         (off-color 'button-off-color))
    (when (or (= 0 *color-mode*) (not (send graph :use-color)))
          (setf on-color 'black)
          (setf off-color 'white))
    (when paint 
          (send graph :draw-color on-color)
          (send graph :paint-rect a b c d)
          (send graph :draw-color 'black)
          (send graph :frame-rect a b c d))
    (when (not paint)
          (send graph :draw-color off-color)
          (send graph :paint-rect a b c d)
          (send graph :draw-color 'black)
          (send graph :frame-rect a b c d))))